home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.03 Jul 92 / Equation Compiler / EqnCompiler.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-21  |  19.7 KB  |  635 lines  |  [TEXT/KAHL]
  1. /* Contains the equation compiler */
  2.  
  3. #include    <ctype.h>
  4. #include    <SANE.h>
  5. #include    "EqnCompiler.h"
  6.  
  7. /* Global Variables */
  8. static int        **codeBlock;    /* handle to code */
  9. static char    *textPtr;        /* ptr to eqn text */
  10. static int        textLen;        /* length of eqn text */
  11. static char    mode;        /* text scan mode */
  12. static int        *textIndex;    /* current scan posn */
  13. static int        codeIndex;    /* current write posn */
  14. static int        frameIndex;    /* stack frame posn */
  15. static int        frameSize;    /* stack frame size */
  16. extern ProcPtr    CFPtr[];        /* custom func ptrs */
  17.  
  18. int    CompileEqn(void *textBuff, int length, int *index, Handle codeHand)
  19. {
  20.     int    level=0; /* parenthesis level */
  21.     int    operand=0; /* current operand type */
  22.     int    offset; /* coeff offset from array ptr */
  23.     long    operation[MAX_PENDING]; /* stored operns */
  24.     int    opIndex=0; /* next posn in operation[] */
  25.     int    result, error;
  26.     extended    num;
  27.     
  28.     /* re-initialize globals */
  29.     codeBlock = (int **) codeHand;
  30.     textPtr = textBuff;
  31.     textIndex = index;
  32.     textLen = length;
  33.     frameIndex = 0;
  34.     frameSize = 0;
  35.     mode = OPERAND_SCAN;
  36.     
  37.     SetHandleSize(codeBlock, 0); /* zero code blk */
  38.     if (MemError()) return memoryErr;
  39.     
  40.     /* get first char, ignore white space chars */
  41.     while (isspace(*(textPtr+*textIndex)) && *textIndex<textLen)
  42.         (*textIndex)++;
  43.     if (*textIndex>=textLen || *(textPtr+*textIndex)==';')
  44.         return nullEqnErr;
  45.     
  46.     /* code for setting up a stack frame */
  47.     codeIndex = 2;
  48.     SetHandleSize(codeBlock, 4);
  49.     if (MemError()) return memoryErr;
  50.     **codeBlock = 0x4E56; /* link A6,#-__ ; (fill in size of frame later) */
  51.     
  52.     while (true) {
  53.         if (mode == OPERAND_SCAN) {
  54.             /* scan for operand or unary function */
  55.             if ((*(textPtr+*textIndex)=='.') || isdigit(*(textPtr+*textIndex))) {
  56.                 /* scan for numeric constant */
  57.                 if (operand) {
  58.                     /* copy old operand to frame */
  59.                     error = OperandCode(operand, offset, &num);
  60.                     if (error) return error;
  61.                 }
  62.                 error = ScanNum(&num);
  63.                 if (error) return error;
  64.                 operand = CONST_OPERAND;
  65.             } else {
  66.                 /* scan for operand or unary function */
  67.                 error = ScanFn(&result);
  68.                 if (error) return error;
  69.                 switch (result & 0xF000) {
  70.                     case PARENTH: /* ( */
  71.                         level++; /* inc parenth level */
  72.                         break;
  73.                     case X_OPERAND: /* x */
  74.                     case COEFF_OPERAND: /* a, b, c … */
  75.                     case PI_OPERAND: /* π */
  76.                         if (operand) {
  77.                             /* copy old operand to frame */
  78.                             error = OperandCode(operand, offset, &num);
  79.                             if (error) return error;
  80.                         }
  81.                         operand = result & 0xF000;
  82.                         if (operand == PI_OPERAND) num = pi();
  83.                         else if (operand == COEFF_OPERAND)
  84.                           offset = result & 0x00FF;
  85.                         break;
  86.                     case UN_MINUS: /* unary minus */
  87.                     case UN_FUNC: /* unary function */
  88.                         opIndex++;
  89.                         if (opIndex > MAX_PENDING)
  90.                             return tooManyOpErr;
  91.                         /* add operation to queue */
  92.                         operation[opIndex-1] = level*0x10000 + result;
  93.                         if ((result & 0xF000) != UN_MINUS)
  94.                             level++; /* inc parenth level */
  95.                 }
  96.             }
  97.         } else if (mode == OPERATOR_SCAN) {
  98.             /* scan for binary operator */
  99.             error = ScanOp(&result);
  100.             if (error) return error;
  101.             if (result) { /* found operator */
  102.                 opIndex++;
  103.                 if (opIndex > MAX_PENDING)
  104.                     return tooManyOpErr;
  105.                 /* add operation to queue */
  106.                 operation[opIndex-1] = level*0x10000 + result;
  107.             } else { /* ')' */
  108.                 level--; /* decrement parenth level */
  109.                 if (level < 0) return unbalParenErr;
  110.             }
  111.         }
  112.         /* compact pending operation array */
  113.         while (opIndex > 1) {
  114.             if ((operation[opIndex-1]&RANK) <= (operation[opIndex-2]&RANK)) {
  115.                 /* add opern to code */
  116.                 error = OperationCode(operation[opIndex-2], operand, offset, &num);
  117.                 if (error) return error;
  118.                 operand = 0;
  119.                 /* remove operation from queue */
  120.                 operation[opIndex-2] = operation[opIndex-1];
  121.                 opIndex--;
  122.             } else break;
  123.         }
  124.         /* get next token, ignore white space chars */
  125.         while (isspace(*(textPtr+*textIndex)) && *textIndex<textLen)
  126.             (*textIndex)++;
  127.         if (*textIndex>=textLen || *(textPtr+*textIndex)==';') {
  128.             if (mode==OPERAND_SCAN)
  129.                 return noOperandErr;
  130.             else break;
  131.         }
  132.     }
  133.     
  134.     /* add pending operations to code */
  135.     while (opIndex > 0) {
  136.         error = OperationCode(operation[opIndex-1], operand, offset, &num);
  137.         if (error) return error;
  138.         operand = 0;
  139.         opIndex--; /* remove opern from queue */
  140.     }
  141.     
  142.     if (level) return unbalParenErr;
  143.     /* set frame size of initial link instrn */
  144.     *(*codeBlock+1) = -10*frameSize;
  145.  
  146.     /* code for return value */
  147.     if (operand) error = ReturnCode1(operand, offset, &num);
  148.     else error = ReturnCode2();
  149.     if (error) return error;
  150.     codeIndex += 2; /* unlink and rts code */
  151.     SetHandleSize(codeBlock, 2*codeIndex);
  152.     if (MemError()) return memoryErr;
  153.     *(*codeBlock+codeIndex-2)=0x4E5E; /* unlk A6 */
  154.     *(*codeBlock+codeIndex-1)=0x4E75; /* rts */
  155.     return 0;
  156. }
  157.  
  158. /* scan the text for a number */
  159. int    ScanNum(extended *num)
  160. {
  161.     int        i=0;
  162.     Boolean    valid;
  163.     char        str[MAX_CONST_LEN+1]; /* C str */
  164.     short    index;
  165.     decimal    dec;
  166.     
  167.     do { /* find longest valid numeric string */
  168.         if (i>=MAX_CONST_LEN) return longNumErr;
  169.         str[i] = *(textPtr+*textIndex+i);
  170.         str[i+1] = 0; /* NULL terminator */
  171.         index = 0;
  172.         cstr2dec(str, &index, &dec, &valid);
  173.         if (!valid) break;
  174.         i++;
  175.         if (*textIndex+i>=textLen || *(textPtr+*textIndex+i)==';') break;
  176.     } while (valid);
  177.     
  178.     if (!index) return badNumErr;
  179.     *num = dec2num(&dec);
  180.     if (classextended(*num)<3 && classextended(*num)>-3)
  181.         return badNumErr; /* NAN, INF */
  182.     *textIndex += index;
  183.     mode = OPERATOR_SCAN;
  184.     return 0;
  185. }
  186.  
  187. /* scan text for operand or function */
  188. int    ScanFn(int *result)
  189. {
  190.     char    str[MAX_KWORD_LEN+1]; /* pascal str */
  191.     int    error, i=0;
  192.     
  193.     /* get longest alphabetic substring */
  194.     while (isalpha(*(textPtr+*textIndex+i))) {
  195.         if (i>MAX_KWORD_LEN) return badTokenErr;
  196.         str[i+1] = *(textPtr+*textIndex+i);
  197.         i++;
  198.         if (*textIndex+i>=textLen || *(textPtr+*textIndex+i)==';') break;
  199.     }
  200.     
  201.     str[0] = i; /* length byte */
  202.     switch (i) {
  203.         /* match string against expected strings */
  204.         case 0: /* first char was not alphabetic */
  205.             if (*(textPtr+*textIndex) == '-')
  206.                 /* unary minus */
  207.                 *result = UN_MINUS+FP68K+(FNEGX&0x00FF);
  208.             else if (*(textPtr+*textIndex) == '(')
  209.                 *result = PARENTH; /* '(' */
  210.             else if (*(textPtr+*textIndex) == 'π' || *(textPtr+*textIndex) == '∏') {
  211.                 *result = PI_OPERAND; /* pi */
  212.                 mode = OPERATOR_SCAN;
  213.             } else return noOperandErr;
  214.             (*textIndex)++;
  215.             return 0;
  216.         case 1: /* single alphabetic character */
  217.             if (tolower(str[1]) >= 'a' && tolower(str[1]) <= 'e') { /* coefficient */
  218.                 switch (tolower(str[1])) {
  219.                     case 'a':
  220.                         *result = COEFF_OPERAND;
  221.                         break;
  222.                     case 'b':
  223.                         *result = COEFF_OPERAND + 10;
  224.                         break;
  225.                     case 'c':
  226.                         *result = COEFF_OPERAND + 20;
  227.                         break;
  228.                     case 'd':
  229.                         *result = COEFF_OPERAND + 30;
  230.                         break;
  231.                     case 'e':
  232.                         *result = COEFF_OPERAND + 40;
  233.                 }
  234.             } else if (tolower(str[1]) == 'x')
  235.                 *result = X_OPERAND; /* x */
  236.             else goto lookup; /* custom func? */
  237.             (*textIndex)++;
  238.             mode = OPERATOR_SCAN;
  239.             return 0;
  240.         case 2: /* two alphabetic characters */
  241.             if (EqualString(str, "\ppi", false, true))
  242.                 *result = PI_OPERAND; /* pi */
  243.             else goto lookup; /* custom func? */
  244.             *textIndex += 2;
  245.             mode = OPERATOR_SCAN;
  246.             return 0;
  247.         case 3: /* three alphabetic characters */
  248.             if (EqualString(str, "\psin", 0, 1))
  249.                 *result = UN_FUNC+ELEMS68K+(FSINX&0x00FF);
  250.             else if (EqualString(str, "\pcos", 0, 1))
  251.                 *result = UN_FUNC+ELEMS68K+(FCOSX&0x00FF);
  252.             else if (EqualString(str, "\ptan", 0, 1))
  253.                 *result = UN_FUNC+ELEMS68K+(FTANX&0x00FF);
  254.             else if (EqualString(str, "\plog", 0, 1))
  255.                 *result = UN_FUNC+ELEMS68K+(FLNX&0x00FF);
  256.             else if (EqualString(str, "\pexp", 0, 1))
  257.                 *result = UN_FUNC+ELEMS68K+(FEXPX&0x00FF);
  258.             else goto lookup; /* custom func? */
  259.             break;
  260.         case 4: /* four alphabetic characters */
  261.             if (EqualString(str, "\psqrt", 0, 1))
  262.                 *result = UN_FUNC+FP68K+(FSQRTX&0x00FF);
  263.             else if (EqualString(str, "\patan", 0, 1))
  264.                 *result = UN_FUNC+ELEMS68K+(FATANX&0x00FF);
  265.             else goto lookup; /* custom func? */
  266.             break;
  267.         default: /* other string lengths */
  268.         lookup: /* custom func? */
  269.                 error = LookUpCF(str, result);
  270.                 if (error) return error;
  271.     }
  272.  
  273.     /* check next char is '(' */
  274.     while (isspace(*(textPtr+*textIndex+i)) && *textIndex+i<textLen) i++;
  275.     if (*textIndex+i>=textLen || *(textPtr+*textIndex+i)==';' || *(textPtr+*textIndex+i)!='(')
  276.         return noLeftParenErr;
  277.     *textIndex += i+1;
  278.     return 0;
  279. }
  280.  
  281. /* scan text for an operator */
  282. int    ScanOp(int *result)
  283. {
  284.     switch (*(textPtr+*textIndex)) {
  285.         case '+': /* addition */
  286.             *result = PRIORITY_1+FP68K+(FADDX&0x00FF);
  287.             break;
  288.         case '-': /* subtraction */
  289.             *result = PRIORITY_1+FP68K+(FSUBX&0x00FF);
  290.             break;
  291.         case '*': /* multiplication */
  292.             *result = PRIORITY_2+FP68K+(FMULX&0x00FF);
  293.             break;
  294.         case '/': /* division */
  295.             *result = PRIORITY_2+FP68K+(FDIVX&0x00FF);
  296.             break;
  297.         case '^': /* exponentiation */
  298.             *result = EXPONENT+ELEMS68K+(FXPWRY&0x00FF);
  299.             break;
  300.         case ')': /* end of parenthesis */
  301.             *result = PARENTH;
  302.             break;
  303.         default: /* syntax error */
  304.             return noOperatorErr;
  305.     }
  306.  
  307.     /* don't change mode if ')' encountered */
  308.     if (*result != PARENTH) mode = OPERAND_SCAN;
  309.     (*textIndex)++;
  310.     return 0;
  311. }
  312.  
  313. /* classify operation, call handler routines */
  314. int    OperationCode(int operation, int operand, int offset, extended *numPtr)
  315. {
  316.     int    error;
  317.     
  318.     if ((operation&0xF000) == UN_MINUS || (operation&0xF000) == UN_FUNC) {
  319.         /* unary operation */
  320.         if (operand) {
  321.             error = OperandCode(operand, offset, numPtr);
  322.             if (error) return error;
  323.         }
  324.         error = UnOpCode(operation);
  325.         if (error) return error;
  326.     } else {
  327.         /* binary operation */
  328.         if (operand == X_OPERAND || operand == COEFF_OPERAND) {
  329.             error = BinOpCode1(operation, operand, offset);
  330.             if (error) return error;
  331.         } else {
  332.             if (operand == CONST_OPERAND) {
  333.                 error = OperandCode(CONST_OPERAND, 0, numPtr);
  334.                 if (error) return error;
  335.             }
  336.             error = BinOpCode2(operation);
  337.             if (error) return error;
  338.         }
  339.     }
  340.     return 0;
  341. }
  342.  
  343. /* set up code for copying operand into stack frame */
  344. int    OperandCode(int operand,  int offset, extended *numPtr)
  345. {
  346.     frameIndex++;
  347.     if (frameIndex>frameSize) frameSize=frameIndex;
  348.     if (operand == X_OPERAND) {
  349.         codeIndex += 7;
  350.         SetHandleSize(codeBlock, 2*codeIndex);
  351.         if (MemError()) return memoryErr;
  352.         /* lea.l -10fi(A6),A0; A0 <- frame_adr */
  353.         *(*codeBlock+codeIndex-7) = 0x41EE;
  354.         *(*codeBlock+codeIndex-6) = -10*frameIndex;
  355.         /* lea.l 12(A6),A1; A1 <- x_adr */
  356.         *(*codeBlock+codeIndex-5) = 0x43EE;
  357.         *(*codeBlock+codeIndex-4) = 0x000C;
  358.         /* move.l (A1)+,(A1)+; copy x into frame */
  359.         *(*codeBlock+codeIndex-3) = 0x20D9;
  360.         /* move.l (A1)+,(A1)+ */
  361.         *(*codeBlock+codeIndex-2) = 0x20D9;
  362.         /* move.w (A1)+,(A1)+ */
  363.         *(*codeBlock+codeIndex-1) = 0x30D9;
  364.     } else if (operand == COEFF_OPERAND) {
  365.         codeIndex += 2;
  366.         SetHandleSize(codeBlock, 2*codeIndex);
  367.         if (MemError()) return memoryErr;
  368.         /* move.l 22(A6),A0; A0 <- coeff base adr */
  369.         *(*codeBlock+codeIndex-2) = 0x206E;
  370.         *(*codeBlock+codeIndex-1) = 0x0016;
  371.         if (offset) {
  372.             codeIndex += 3;
  373.             SetHandleSize(codeBlock, 2*codeIndex);
  374.             if (MemError()) return memoryErr;
  375.             /* move.l off(A0),-10fi(A6); copy coeff */
  376.             *(*codeBlock+codeIndex-3) = 0x2D68;
  377.             *(*codeBlock+codeIndex-2) = offset;
  378.             *(*codeBlock+codeIndex-1) = -10*frameIndex;
  379.         } else {
  380.             codeIndex += 2;
  381.             SetHandleSize(codeBlock, 2*codeIndex);
  382.             if (MemError()) return memoryErr;
  383.             /* move.l (A0),-10fi(A6); copy coeff */
  384.             *(*codeBlock+codeIndex-2) = 0x2D50;
  385.             *(*codeBlock+codeIndex-1) = -10*frameIndex;
  386.         }
  387.         codeIndex += 6;
  388.         SetHandleSize(codeBlock, 2*codeIndex);
  389.         if (MemError()) return memoryErr;
  390.         /* move.l off+4(A0),-10fi+4(A6); copy coeff */
  391.         *(*codeBlock+codeIndex-6) = 0x2D68;
  392.         *(*codeBlock+codeIndex-5) = offset+4;
  393.         *(*codeBlock+codeIndex-4) = -10*frameIndex+4;
  394.         /* move.w off+8(A0),-10fi+8(A6); copy coeff */
  395.         *(*codeBlock+codeIndex-3) = 0x3D68;
  396.         *(*codeBlock+codeIndex-2) = offset+8;
  397.         *(*codeBlock+codeIndex-1) = -10*frameIndex+8;
  398.     } else if (operand == CONST_OPERAND) {
  399.         codeIndex += 11;
  400.         SetHandleSize(codeBlock, 2*codeIndex);
  401.         if (MemError()) return memoryErr;
  402.         /* move.l #__,-10fi(A6); frame <- const */
  403.         *(*codeBlock+codeIndex-11) = 0x2D7C;
  404.         *(*codeBlock+codeIndex-10) = *((int *) numPtr);
  405.         *(*codeBlock+codeIndex-9) = *((int *) numPtr+1);
  406.         *(*codeBlock+codeIndex-8) = -10*frameIndex;
  407.         /* move.l #__,-10fi+4(A6) */
  408.         *(*codeBlock+codeIndex-7) = 0x2D7C;
  409.         *(*codeBlock+codeIndex-6) = *((int *) numPtr+2);
  410.         *(*codeBlock+codeIndex-5) = *((int *) numPtr+3);
  411.         *(*codeBlock+codeIndex-4) = -10*frameIndex+4;
  412.         /* move.w #__,-10fi+8(A6) */
  413.         *(*codeBlock+codeIndex-3) = 0x3D7C;
  414.         *(*codeBlock+codeIndex-2) = *((int *) numPtr+4);
  415.         *(*codeBlock+codeIndex-1) = -10*frameIndex+8;
  416.     } else return miscErr;
  417.     return 0;
  418. }
  419.  
  420. /* write code for unary function, operand in stack frame */
  421. int    UnOpCode(int operation)
  422. {
  423.     if (!frameIndex) return miscErr;
  424.     if ((operation&0x0F00)==FP68K || (operation&0x0F00)==ELEMS68K) {
  425.         /* SANE func */
  426.         codeIndex += 5;
  427.         SetHandleSize(codeBlock, 2*codeIndex);
  428.         if (MemError()) return memoryErr;
  429.         /* pea.l -10fi(A6); push operand_adr */
  430.         *(*codeBlock+codeIndex-5) = 0x486E;
  431.         *(*codeBlock+codeIndex-4) = -10*frameIndex;
  432.         /* move.w opword, -(A7); push SANE opword */
  433.         *(*codeBlock+codeIndex-3) = 0x3F3C;
  434.         *(*codeBlock+codeIndex-2) = operation&0x00FF;
  435.         if ((operation&0x0F00) == FP68K)
  436.             *(*codeBlock+codeIndex-1)=0xA9EB;/* _Pack4 */
  437.         else if ((operation&0x0F00) == ELEMS68K)
  438.             *(*codeBlock+codeIndex-1)=0xA9EC;/* _Pack5*/
  439.         else return miscErr;
  440.     } else if ((operation&0x0F00) == CUSTOM) {
  441.         /* custom unary function */
  442.         codeIndex += 14;
  443.         SetHandleSize(codeBlock, 2*codeIndex);
  444.         if (MemError()) return memoryErr;
  445.         /* move.l -10fi+6(A6),-(A7); push operand */
  446.         *(*codeBlock+codeIndex-14) = 0x2F2E;
  447.         *(*codeBlock+codeIndex-13) = -10*frameIndex+6;
  448.         /* move.l -10fi+2(A6),-(A7) */
  449.         *(*codeBlock+codeIndex-12) = 0x2F2E;
  450.         *(*codeBlock+codeIndex-11) = -10*frameIndex+2;
  451.         /* move.w -10fi(A6),-(A7) */
  452.         *(*codeBlock+codeIndex-10) = 0x3F2E;
  453.         *(*codeBlock+codeIndex-9) = -10*frameIndex;
  454.         /* pea.l -10fi(A6); push result adr */
  455.         *(*codeBlock+codeIndex-8) = 0x486E;
  456.         *(*codeBlock+codeIndex-7) = -10*frameIndex;
  457.         /* move.l #__,A0; A0 <- func_adr */
  458.         *(*codeBlock+codeIndex-6) = 0x207C;
  459.         *(*codeBlock+codeIndex-5) = HiWord((long) CFPtr[operation&0x00FF]);
  460.         *(*codeBlock+codeIndex-4) = LoWord((long) CFPtr[operation&0x00FF]);
  461.         /* jsr (A0); jump to func */
  462.         *(*codeBlock+codeIndex-3) = 0x4E90;
  463.         /* lea.l 14(A7),A7; reset stack ptr */
  464.         *(*codeBlock+codeIndex-2) = 0x4FEF;
  465.         *(*codeBlock+codeIndex-1) = 0x000E;
  466.     } else return miscErr;
  467.     return 0;
  468. }
  469.  
  470. /* set up binary operation code - only destination operand in stack frame */
  471. int    BinOpCode1(int operation, int operand, int offset)
  472. {
  473.     if (frameIndex < 1) return miscErr;
  474.     if (operand == X_OPERAND) {
  475.         codeIndex += 2;
  476.         SetHandleSize(codeBlock, 2*codeIndex);
  477.         if (MemError()) return memoryErr;
  478.         /* pea.l 12(A6); push x_adr */
  479.         *(*codeBlock+codeIndex-2) = 0x486E;
  480.         *(*codeBlock+codeIndex-1) = 0x000C;
  481.     } else if (operand == COEFF_OPERAND) {
  482.         codeIndex += 2;
  483.         SetHandleSize(codeBlock, 2*codeIndex);
  484.         if (MemError()) return memoryErr;
  485.         /* move.l 22(A6),A0; A0 <- coeff base adr */
  486.         *(*codeBlock+codeIndex-2) = 0x206E;
  487.         *(*codeBlock+codeIndex-1) = 0x0016;
  488.         if (offset) {
  489.             codeIndex += 2;
  490.             SetHandleSize(codeBlock, 2*codeIndex);
  491.             if (MemError()) return memoryErr;
  492.             /* pea.l off(A0); push coeff_adr */
  493.             *(*codeBlock+codeIndex-2) = 0x4868;
  494.             *(*codeBlock+codeIndex-1) = offset;
  495.         } else {
  496.             codeIndex++;
  497.             SetHandleSize(codeBlock, 2*codeIndex);
  498.             if (MemError()) return memoryErr;
  499.             /* pea.l (A0); push coeff_adr */
  500.             *(*codeBlock+codeIndex-1) = 0x4850;
  501.         }
  502.     } else return miscErr;
  503.     codeIndex += 5;
  504.     SetHandleSize(codeBlock, 2*codeIndex);
  505.     if (MemError()) return memoryErr;
  506.     /*  pea.l -10fi(A6); push dest_adr  */
  507.     *(*codeBlock+codeIndex-5) = 0x486E;
  508.     *(*codeBlock+codeIndex-4) = -10*frameIndex;
  509.     if ((operation&0xF000) == EXPONENT) {
  510.         /* move.w FXPWRY,-(A7); push FXPWRY */
  511.         *(*codeBlock+codeIndex-3) = 0x3F3C;
  512.         *(*codeBlock+codeIndex-2) = FXPWRY;
  513.         *(*codeBlock+codeIndex-1)=0xA9EC;/* _Pack5 */
  514.     } else if ((operation&0x0F00) == FP68K) {
  515.         /* move.w opword,-(A7); push SANE opword */
  516.         *(*codeBlock+codeIndex-3) = 0x3F3C;
  517.         *(*codeBlock+codeIndex-2) = operation&0x00FF;
  518.         *(*codeBlock+codeIndex-1)=0xA9EB;/* _Pack4 */
  519.     } else return miscErr;
  520.     return 0;
  521. }
  522.  
  523. /* set up binary operation code - both operands are in stack frame */
  524. int    BinOpCode2(int operation)
  525. {
  526.     if (frameIndex < 2) return miscErr;
  527.     codeIndex += 7;
  528.     SetHandleSize(codeBlock, 2*codeIndex);
  529.     if (MemError()) return memoryErr;
  530.     /* pea.l -10fi(A6); push src operand */
  531.     *(*codeBlock+codeIndex-7) = 0x486E;
  532.     *(*codeBlock+codeIndex-6) = -10*frameIndex;
  533.     /* pea.l -10fi+10(A6); push dest operand */
  534.     *(*codeBlock+codeIndex-5) = 0x486E;
  535.     *(*codeBlock+codeIndex-4) = -10*frameIndex+10;
  536.     if ((operation&0xF000) == EXPONENT) {
  537.         /* move.w FXPWRY,-(A7); push FXWPRY */
  538.         *(*codeBlock+codeIndex-3) = 0x3F3C;
  539.         *(*codeBlock+codeIndex-2) = FXPWRY;
  540.         *(*codeBlock+codeIndex-1)=0xA9EC;/* _Pack5 */
  541.     } else if ((operation&0x0F00) == FP68K) {
  542.         /* move.w opword,-(A7); push SANE opword */
  543.         *(*codeBlock+codeIndex-3) = 0x3F3C;
  544.         *(*codeBlock+codeIndex-2) = operation&0x00FF;
  545.         *(*codeBlock+codeIndex-1)=0xA9EB;/* _Pack4 */
  546.     } else return miscErr;
  547.     frameIndex--; /* decrement frame position */
  548.     return 0;
  549. }
  550.  
  551. /* copy operand to address specified by 8(A6) */
  552. int    ReturnCode1(int operand, int offset, extended *numPtr)
  553. {
  554.     if (operand == CONST_OPERAND) {
  555.         codeIndex += 10;
  556.         SetHandleSize(codeBlock, 2*codeIndex);
  557.         if (MemError()) return memoryErr;
  558.         /* move.l 8(A6),A0; A0 <- result_adr */
  559.         *(*codeBlock+codeIndex-10) = 0x206E;
  560.         *(*codeBlock+codeIndex-9) = 0x0008;
  561.         /* move.l #__,(A0)+; copy const to result_adr */
  562.         *(*codeBlock+codeIndex-8) = 0x20FC;
  563.         *(*codeBlock+codeIndex-7) = *((int *) numPtr);
  564.         *(*codeBlock+codeIndex-6) = *((int *) numPtr+1);
  565.         /* move.l #__,(A0)+ */
  566.         *(*codeBlock+codeIndex-5) = 0x20FC;
  567.         *(*codeBlock+codeIndex-4) = *((int *) numPtr+2);
  568.         *(*codeBlock+codeIndex-3) = *((int *) numPtr+3);
  569.         /* move.w #__,(A0)+ */
  570.         *(*codeBlock+codeIndex-2) = 0x30FC;
  571.         *(*codeBlock+codeIndex-1) = *((int *) numPtr+4);
  572.         return 0;
  573.     } else if (operand == X_OPERAND) {
  574.         codeIndex += 4;
  575.         SetHandleSize(codeBlock, 2*codeIndex);
  576.         if (MemError()) return memoryErr;
  577.         /* move.l 8(A6),A0; A0 <- result_adr */
  578.         *(*codeBlock+codeIndex-4) = 0x206E;
  579.         *(*codeBlock+codeIndex-3) = 0x0008;
  580.         /* lea.l 12(A6),A1; A1 <- x_adr */
  581.         *(*codeBlock+codeIndex-2) = 0x43EE;
  582.         *(*codeBlock+codeIndex-1) = 0x000C;
  583.     } else if (operand == COEFF_OPERAND) {
  584.         codeIndex += 4;
  585.         SetHandleSize(codeBlock, 2*codeIndex);
  586.         if (MemError()) return memoryErr;
  587.         /* move.l 8(A6),A0; A0 <- result_adr */
  588.         *(*codeBlock+codeIndex-4) = 0x206E;
  589.         *(*codeBlock+codeIndex-3) = 0x0008;
  590.         /* move.l 22(A6),A1; A1 <- coeff base Adr */
  591.         *(*codeBlock+codeIndex-2) = 0x226E;
  592.         *(*codeBlock+codeIndex-1) = 0x0016;
  593.         if (offset) {
  594.             codeIndex += 2;
  595.             SetHandleSize(codeBlock, 2*codeIndex);
  596.             if (MemError()) return memoryErr;
  597.             /* lea.l off(A1),A1; A1 <- coeff_adr */
  598.             *(*codeBlock+codeIndex-2) = 0x43E9;
  599.             *(*codeBlock+codeIndex-1) = offset;
  600.         }
  601.     } else return miscErr;
  602.     codeIndex += 3;
  603.     SetHandleSize(codeBlock, 2*codeIndex);
  604.     if (MemError()) return memoryErr;
  605.     /* move.l (A1)+,(A0)+; copy operand to result */
  606.     *(*codeBlock+codeIndex-3) = 0x20D9;
  607.     /* move.l (A1)+,(A0)+ */
  608.     *(*codeBlock+codeIndex-2) = 0x20D9;
  609.     /* move.w (A1)+,(A0)+ */
  610.     *(*codeBlock+codeIndex-1) = 0x30D9;
  611.     return 0;
  612. }
  613.  
  614. /* copy result to address in 8(A6) */
  615. int    ReturnCode2(void)
  616. {
  617.     codeIndex += 7;
  618.     SetHandleSize(codeBlock, 2*codeIndex);
  619.     if (MemError()) return memoryErr;
  620.     /* move.l 8(A6),A0; A0 <- result_adr */
  621.     *(*codeBlock+codeIndex-7) = 0x206E;
  622.     *(*codeBlock+codeIndex-6) = 0x0008;
  623.     /* lea.l -10(A6),A1; A1 <- frame_adr */
  624.     *(*codeBlock+codeIndex-5) = 0x43EE;
  625.     *(*codeBlock+codeIndex-4) = 0xFFF6;
  626.     /* move.l (A1)+,(A0)+; copy frame to result */
  627.     *(*codeBlock+codeIndex-3) = 0x20D9;
  628.     /* move.l (A1)+,(A0)+ */
  629.     *(*codeBlock+codeIndex-2) = 0x20D9;
  630.     /* move.w (A1)+,(A0)+ */
  631.     *(*codeBlock+codeIndex-1) = 0x30D9;
  632.     return 0;
  633. }
  634.  
  635.